home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Direct3D / PixelShader / frmPixelShader.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  20.5 KB  |  539 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPixelShader 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "VB Pixel Shader"
  5.    ClientHeight    =   3195
  6.    ClientLeft      =   60
  7.    ClientTop       =   330
  8.    ClientWidth     =   4680
  9.    Icon            =   "frmPixelShader.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3195
  14.    ScaleWidth      =   4680
  15.    StartUpPosition =   3  'Windows Default
  16. Attribute VB_Name = "frmPixelShader"
  17. Attribute VB_GlobalNameSpace = False
  18. Attribute VB_Creatable = False
  19. Attribute VB_PredeclaredId = True
  20. Attribute VB_Exposed = False
  21. Option Explicit
  22. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  23. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  24. '  File:       FrmPixelShader.frm
  25. '  Content:    This sample shows how to use Pixel Shaders. It renders a few polys with
  26. '              different pixel shader functions to manipulate the way the textures look.
  27. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  28. ' This sample will use 7 different shaders.
  29. Private Const NUM_PIXELSHADERS = 7
  30. ' A structure to describe the type of vertices the app will use.
  31. Private Type VERTEX2TC_
  32.     x As Single
  33.     y As Single
  34.     z As Single
  35.     rhw As Single
  36.     color0 As Long
  37.     color1 As Long
  38.     tu0 As Single
  39.     tv0 As Single
  40.     tu1 As Single
  41.     tv1 As Single
  42. End Type
  43. Dim VERTEX2TC(3) As VERTEX2TC_
  44. Dim verts(3) As VERTEX2TC_
  45. ' Describe the vertex format that the vertices use.
  46. Private Const FVFVERTEX2TC = (D3DFVF_XYZRHW Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR Or D3DFVF_TEX2)
  47. ' Allocate a few DirectX object variables that the app needs to use.
  48. Dim dX As DirectX8
  49. Dim d3d As Direct3D8
  50. Dim dev As Direct3DDevice8
  51. Dim d3dx As D3DX8
  52. Dim d3dvb As Direct3DVertexBuffer8
  53. Dim d3dt(1) As Direct3DTexture8
  54. 'Keep the present params around for resetting the device if needed
  55. Dim g_d3dpp As D3DPRESENT_PARAMETERS
  56. ' This string array will store the shader functions
  57. Dim sPixelShader(6) As String
  58. ' This array will store the pointers to the assembled pixel shaders
  59. Dim hPixelShader(6) As Long
  60. Private Sub Form_Load()
  61. '************************************************************************
  62. ' Here the app will call functions to set up D3D, create a device,
  63. ' initialize the vertices, initialize the vertex buffers, create the
  64. ' textures, setup the shader string arrays, and assemble the pixel shaders.
  65. ' Finally, it calls Form_Paint to render everything.
  66. '************************************************************************
  67.         
  68.     'Set the width and height of the window
  69.     Me.Width = 125 * Screen.TwipsPerPixelX
  70.     Me.Height = 225 * Screen.TwipsPerPixelY
  71.     Me.Show
  72.     DoEvents
  73.     Call InitD3D
  74.     Call InitTextures
  75.     Call InitVerts
  76.     Call SetupShaders
  77.     Call InitDevice
  78.     Call PaintMe
  79.     'Call Form_Paint
  80. End Sub
  81. Private Sub InitVB()
  82. '************************************************************************
  83. ' This sub creates the vertex buffer that the app will use.
  84. ' PARAMETERS:
  85. '           None.
  86. '************************************************************************
  87.                             
  88.     ' Create the vertex buffer, It will hold 4 vertices (two primitives).
  89.     Set d3dvb = dev.CreateVertexBuffer(4 * Len(VERTEX2TC(0)), D3DUSAGE_WRITEONLY, FVFVERTEX2TC, D3DPOOL_MANAGED)
  90.     Call MoveVBVerts(0, 0)
  91. End Sub
  92. Private Sub MoveVBVerts(dX As Single, dY As Single)
  93. '************************************************************************
  94. ' This sub moves the vertices in the vertex buffer to a new location.
  95. ' PARAMETERS:
  96. '           dx: A single that represents the new X coordinate for the upper left hand corner of the vertices.
  97. '           dy: A single that represents the new Y coordinate for the upper left hand corner of the vertices.
  98. '************************************************************************
  99.     Dim pVBVerts(3) As VERTEX2TC_
  100.     Dim pData As Long, i As Long, lSize As Long
  101.     'Store the size of a vertex
  102.     lSize = Len(VERTEX2TC(0))
  103.     'Lock and retrieve the data in the vertex buffer
  104.     Call D3DAUX.D3DVertexBuffer8GetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
  105.     For i = 0 To 3
  106.         'Set this vertex to equal the global vertex
  107.         pVBVerts(i) = verts(i)
  108.         'Add the X component to this vertex
  109.         pVBVerts(i).x = verts(i).x + dX
  110.         'Add the Y component to this vertex
  111.         pVBVerts(i).y = verts(i).y + dY
  112.     Next
  113.     'Set and unlock the data in the vertex buffer.
  114.     Call D3DAUX.D3DVertexBuffer8SetData(d3dvb, 0, lSize * 4, 0, pVBVerts(0))
  115. End Sub
  116. Private Sub InitVerts()
  117. '************************************************************************
  118. ' This sub initializes the vertices
  119. ' PARAMETERS:
  120. '           None.
  121. '************************************************************************
  122.     With verts(0)
  123.         .x = 10: .y = 10: .z = 0.5
  124.         .rhw = 1
  125.         .color0 = MakeRGB(&H0, &HFF, &HFF)
  126.         .color1 = MakeRGB(&HFF, &HFF, &HFF)
  127.         .tu0 = 0: .tv0 = 0
  128.         .tu1 = 0: .tv1 = 0
  129.     End With
  130.     With verts(1)
  131.         .x = 40: .y = 10: .z = 0.5
  132.         .rhw = 1
  133.         .color0 = MakeRGB(&HFF, &HFF, &H0)
  134.         .color1 = MakeRGB(&HFF, &HFF, &HFF)
  135.         .tu0 = 1: .tv0 = 0
  136.         .tu1 = 1: .tv1 = 0
  137.     End With
  138.     With verts(2)
  139.         .x = 40: .y = 40: .z = 0.5
  140.         .rhw = 1
  141.         .color0 = MakeRGB(&HFF, &H0, &H0)
  142.         .color1 = MakeRGB(&H0, &H0, &H0)
  143.         .tu0 = 1: .tv0 = 1
  144.         .tu1 = 1: .tv1 = 1
  145.     End With
  146.     With verts(3)
  147.         .x = 10: .y = 40: .z = 0.5
  148.         .rhw = 1
  149.         .color0 = MakeRGB(&H0, &H0, &HFF)
  150.         .color1 = MakeRGB(&H0, &H0, &H0)
  151.         .tu0 = 0: .tv0 = 1
  152.         .tu1 = 0: .tv1 = 1
  153.     End With
  154. End Sub
  155. Private Sub InitTextures()
  156.         
  157. '************************************************************************
  158. ' This sub initializes the textures that will be used.
  159. ' PARAMETERS:
  160. '           None.
  161. '************************************************************************
  162.     Dim sFile As String
  163.     sFile = FindMediaDir("lake.bmp") & "lake.bmp"
  164.     Set d3dt(1) = d3dx.CreateTextureFromFile(dev, sFile)
  165.     sFile = FindMediaDir("seafloor.bmp") & "seafloor.bmp"
  166.     Set d3dt(0) = d3dx.CreateTextureFromFile(dev, sFile)
  167. End Sub
  168. Private Sub SetupShaders()
  169. '************************************************************************
  170. ' This sub sets up the string arrays that contains each pixel shader.
  171. ' PARAMETERS:
  172. '           None.
  173. '************************************************************************
  174.     ' 0: Display texture 0 (t0)
  175.     sPixelShader(0) = _
  176.     "ps.1.0 " & _
  177.     "tex t0 " & _
  178.     "mov r0,t0"
  179.     ' 1: Display texture 1 (t1)
  180.     sPixelShader(1) = _
  181.     "ps.1.0 " & _
  182.     "tex t1 " & _
  183.     "mov r0,t1"
  184.     ' 2: Blend between tex0 and tex1, using vertex 1 as the input (v1)
  185.     sPixelShader(2) = _
  186.     "ps.1.0 " & _
  187.     "tex t0 " & _
  188.     "tex t1 " & _
  189.     "mov r1,t1 " & _
  190.     "lrp r0,v1,r1,t0"
  191.     ' 3: Scale texture 0 by vertex color 1 and add to texture 1
  192.     sPixelShader(3) = _
  193.     "ps.1.0 " & _
  194.     "tex t0 " & _
  195.     "tex t1 " & _
  196.     "mov r1,t0 " & _
  197.     "mad r0,t1,r1,v1"
  198.     ' 4: Add all: texture 0, 1, and color 0, 1
  199.     sPixelShader(4) = _
  200.     "ps.1.0 " & _
  201.     "tex t0 " & _
  202.     "tex t1 " & _
  203.     "add r1,t0,v1 " & _
  204.     "add r1,r1,t1 " & _
  205.     "add r1,r1,v0 " & _
  206.     "mov r0,r1"
  207.     ' 5: Modulate t0 by constant register c0
  208.     sPixelShader(5) = _
  209.     "ps.1.0 " & _
  210.     "tex t0 " & _
  211.     "mul r1,c0,t0 " & _
  212.     "mov r0,r1"
  213.     ' 6: Lerp by t0 and t1 by constant register c1
  214.     sPixelShader(6) = _
  215.     "ps.1.0 " & _
  216.     "tex t0 " & _
  217.     "tex t1 " & _
  218.     "mov r1,t1 " & _
  219.     "lrp r0,c1,t0,r1"
  220.         
  221. End Sub
  222. Private Sub InitPixelShaders()
  223. '************************************************************************
  224. ' This sub creates the pixel shaders, and stores the pointer (handle) to them.
  225. ' PARAMETERS:
  226. '           None.
  227. '************************************************************************
  228.     Dim pCode As D3DXBuffer
  229.     Dim i As Long, lArray() As Long, lSize As Long
  230.     'Loop through each pixel shader string
  231.     For i = 0 To UBound(sPixelShader)
  232.         
  233.         'Assemble the pixel shader
  234.         Set pCode = d3dx.AssembleShader(sPixelShader(i), 0, Nothing)
  235.         
  236.         'Get the size of the assembled pixel shader
  237.         lSize = pCode.GetBufferSize() / 4
  238.         
  239.         'Resize the array
  240.         ReDim lArray(lSize - 1)
  241.         
  242.         'Retrieve the contents of the buffer
  243.         Call d3dx.BufferGetData(pCode, 0, 4, lSize, lArray(0))
  244.         
  245.         'Create the pixel shader.
  246.         hPixelShader(i) = dev.CreatePixelShader(lArray(0))
  247.         
  248.         Set pCode = Nothing
  249.         
  250.     Next
  251. End Sub
  252. Private Sub InitDevice()
  253. '************************************************************************
  254. ' This sub initializes the device to states that won't change, and sets
  255. ' the constant values that some of the pixel shaders use.
  256. ' PARAMETERS:
  257. '           None.
  258. '************************************************************************
  259.     ' Constant registers store values that the pixel shaders can use. Each
  260.     ' constant is an array of 4 singles that contain information about color
  261.     ' and alpha components. This 2d array represents two pixel shader constants.
  262.     Dim fPSConst(3, 1) As Single
  263.     'Used to set the constant values for c0 (used in pixel shader 5)
  264.     'Red
  265.     fPSConst(0, 0) = 0.15
  266.     'Green
  267.     fPSConst(1, 0) = 0.75
  268.     'Blue
  269.     fPSConst(2, 0) = 0.25
  270.     'Alpha
  271.     fPSConst(3, 0) = 0
  272.     'Used to set the constant values for c1 (used in pixel shader 6)
  273.     'Red
  274.     fPSConst(0, 1) = 0.15
  275.     'Green
  276.     fPSConst(1, 1) = 1
  277.     'Blue
  278.     fPSConst(2, 1) = 0.5
  279.     'Alpha
  280.     fPSConst(3, 1) = 0
  281.     'Create the vertex buffer
  282.     Call InitVB
  283.     'Create the pixel shaders
  284.     Call InitPixelShaders
  285.     With dev
  286.         
  287.         'Lighting isn't needed, since the vertices are prelit
  288.         Call .SetRenderState(D3DRS_LIGHTING, False)
  289.         
  290.         'Point the stream source to the vertex buffer that contains the vertices for rendering.
  291.         Call .SetStreamSource(0, d3dvb, Len(VERTEX2TC(0)))
  292.         
  293.         'Set the vertex shader to the flexible vertex format the app describes.
  294.         Call .SetVertexShader(FVFVERTEX2TC)
  295.         
  296.         'Set the pixel shader constans to the values that were set above.
  297.         Call .SetPixelShaderConstant(0, fPSConst(0, 0), 2)
  298.         
  299.     End With
  300. End Sub
  301. Private Sub PaintMe()
  302. '************************************************************************
  303. ' This sub is where all rendering happens. The vertices get moved to
  304. ' a new position, and then rendered.
  305. ' PARAMETERS:
  306. '              None.
  307. '************************************************************************
  308.             
  309.     Dim hr As Long
  310.     Static bNotReady As Boolean
  311.     If Not dev Is Nothing And Me.ScaleHeight > 0 And Not d3dvb Is Nothing Then
  312.         'Call TestCooperativeLevel to see what state the device is in.
  313.         hr = dev.TestCooperativeLevel
  314.         
  315.         If hr = D3DERR_DEVICELOST Then
  316.             
  317.             'If the device is lost, exit and wait for it to come back.
  318.             bNotReady = True
  319.             Exit Sub
  320.         
  321.         ElseIf hr = D3DERR_DEVICENOTRESET Then
  322.             
  323.             'The device is back, now it needs to be reset.
  324.             hr = 0
  325.             hr = ResetDevice
  326.             If hr Then Exit Sub
  327.             
  328.             bNotReady = False
  329.             
  330.         End If
  331.         
  332.         'Make sure the app is ready and that the form's height is greater than 0
  333.         If bNotReady Or Me.ScaleHeight < 1 Then Exit Sub
  334.                 
  335.         With dev
  336.                                     
  337.             Call .BeginScene
  338.             Call .Clear(0, ByVal 0, D3DCLEAR_TARGET, MakeRGB(0, 0, 255), 0, 0)
  339.             'To just show the interpolation of each vertex color, remove all of the textures.
  340.             Call .SetTexture(0, Nothing)
  341.             Call .SetTexture(1, Nothing)
  342.             
  343.             'Move the vertices.
  344.             Call MoveVBVerts(0, 0)
  345.             'No pixel shader will be used for this one.
  346.             Call .SetPixelShader(0)
  347.             'Draw the two primitives.
  348.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  349.                                     
  350.             'Now set the two textures on the device.
  351.             Call .SetTexture(0, d3dt(0))
  352.             Call .SetTexture(1, d3dt(1))
  353.             
  354.             'Move the vertices
  355.             Call MoveVBVerts(50, 0)
  356.             'Use pixel shader 0
  357.             Call .SetPixelShader(hPixelShader(0))
  358.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  359.             
  360.             'The rest of the calls just move the vertices to a new position, set
  361.             'the next pixel shader, and render the two primitives.
  362.             Call MoveVBVerts(0, 50)
  363.             Call .SetPixelShader(hPixelShader(1))
  364.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  365.             Call MoveVBVerts(50, 50)
  366.             Call .SetPixelShader(hPixelShader(2))
  367.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  368.         
  369.             Call MoveVBVerts(0, 100)
  370.             Call .SetPixelShader(hPixelShader(3))
  371.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  372.             Call MoveVBVerts(50, 100)
  373.             Call .SetPixelShader(hPixelShader(4))
  374.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  375.             Call MoveVBVerts(0, 150)
  376.             Call .SetPixelShader(hPixelShader(5))
  377.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  378.             Call MoveVBVerts(50, 150)
  379.             Call .SetPixelShader(hPixelShader(6))
  380.             Call .DrawPrimitive(D3DPT_TRIANGLEFAN, 0, 2)
  381.             Call .EndScene
  382.             Call .Present(ByVal 0, ByVal 0, 0, ByVal 0)
  383.         
  384.         End With
  385.         
  386.     End If
  387. End Sub
  388. Private Function MakeRGB(r As Long, g As Long, b As Long) As Long
  389. '************************************************************************
  390. ' This function takes three longs and packs them into a single long to
  391. ' create an RGB color. Each parameter has to be in the range of 0-255.
  392. ' PARAMETERS:
  393. '           r   Long that represents the red component
  394. '           g   Long that represents the green component
  395. '           b   Long that represents the blue component
  396. ' RETURNS:
  397. '           A long that.
  398. '************************************************************************
  399.     MakeRGB = b
  400.     MakeRGB = MakeRGB Or (g * (2 ^ 8))
  401.     MakeRGB = MakeRGB Or (r * (2 ^ 16))
  402. End Function
  403. Private Sub InitD3D()
  404. '************************************************************************
  405. ' This sub initializes all the object variables, and creates the 3d device.
  406. ' PARAMETERS:
  407. '            None.
  408. '************************************************************************
  409.     Dim d3ddm As D3DDISPLAYMODE
  410.     'Turn off error handling, the app will handle any errors that occur.
  411.     On Local Error Resume Next
  412.         
  413.     'Get a new D3DX object
  414.     Set d3dx = New D3DX8
  415.     'Get a new DirectX object
  416.     Set dX = New DirectX8
  417.     'Create a Direct3D object
  418.     Set d3d = dX.Direct3DCreate()
  419.     'Grab some information about the current display mode to see if the display
  420.     'was switched to something that isn't supported.
  421.     Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
  422.     'Make sure that the adapter is in a color bit depth greater than 8 bits per pixel.
  423.     If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
  424.         
  425.         'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
  426.         MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
  427.         Unload Me
  428.         End
  429.         
  430.     End If
  431.     With g_d3dpp
  432.         
  433.         'This app will run windowed.
  434.         .Windowed = 1
  435.         
  436.         'The backbuffer format is unknown. Since this is windowed mode,
  437.         'the app can just use whatever mode the device is in now.
  438.         .BackBufferFormat = d3ddm.Format
  439.         
  440.         'When running windowed, the information contained in the
  441.         'backbuffer is copied to the front buffer when Direct3DDevice.Present is called.
  442.         .SwapEffect = D3DSWAPEFFECT_COPY
  443.         
  444.     End With
  445.     'Create the device using the default adapter on the system using software vertex processing.
  446.     Set dev = d3d.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, g_d3dpp)
  447.         
  448.     'Check to make sure the device was created successfully. If not, exit.
  449.     If dev Is Nothing Then
  450.         MsgBox "Unable to initialize Direct3D. App will now exit."
  451.         Unload Me
  452.         End
  453.     End If
  454. End Sub
  455. Private Sub Form_Paint()
  456.     If d3dvb Is Nothing Then Exit Sub
  457.     'Anytime the window receives a paint message, repaint the scene.
  458.     Call PaintMe
  459. End Sub
  460. Private Sub Form_Resize()
  461.     If d3dvb Is Nothing Then Exit Sub
  462.     'Anytime the form is resized, redraw the scene.
  463.     Call PaintMe
  464. End Sub
  465.         
  466. Private Function ResetDevice() As Long
  467. '***********************************************************************
  468. ' This subroutine is called whenever the app needs to be resized, or the
  469. ' device has been lost.
  470. ' Parameters:
  471. '   None.
  472. '***********************************************************************
  473.         
  474.     Dim d3ddm As D3DDISPLAYMODE
  475.     On Local Error Resume Next
  476.     'Call the sub that destroys the vertex buffer and shaders.
  477.     Call DestroyAll
  478.     'Set the width and height of the window
  479.     Me.Width = 110 * Screen.TwipsPerPixelX
  480.     Me.Height = 225 * Screen.TwipsPerPixelY
  481.      'Grab some information about the current adapters display mode.
  482.     'This may have changed since startup or the last D3DDevice8.Reset().
  483.     Call d3d.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm)
  484.         
  485.     'Refresh the backbuffer format using the retrieved format.
  486.      g_d3dpp.BackBufferFormat = d3ddm.Format
  487.     'Now reset the device.
  488.     Call dev.Reset(g_d3dpp)
  489.     'If something happens during the reset, trap any possible errors. This probably failed
  490.     'because the app doesn't have focus yet, but could fail is the user switched to an incompatible
  491.     'display mode.
  492.     If Err.Number Then
  493.                 
  494.         'Make sure that the adapter is in a color bit-depth greater than 8 bits per pixel.
  495.         If d3ddm.Format = D3DFMT_P8 Or d3ddm.Format = D3DFMT_A8P8 Then
  496.             
  497.             'Device is running in some variation of an 8 bit format. Sample will have to exit at this point.
  498.             MsgBox " For this sample to run, the primary display needs to be in 16 bit or higher color depth.", vbCritical
  499.             Unload Me
  500.             End
  501.             
  502.         Else
  503.             
  504.             'More than likely the app just lost the display adapter. Keep spinning until the adapter becomes available.
  505.             ResetDevice = Err.Number
  506.             Exit Function
  507.             
  508.         End If
  509.     End If
  510.         
  511.     'Now get the device ready again
  512.     Call InitDevice
  513.     'Redraw the scene
  514.     PaintMe
  515. End Function
  516. Private Sub Form_Unload(Cancel As Integer)
  517.     ' When the app is exiting, call the DestroyAll() function to clean up.
  518.     Call DestroyAll
  519. End Sub
  520. Private Sub DestroyAll()
  521. '***********************************************************************
  522. ' This sub releases all the objects and pixel shader handles.
  523. ' PARAMETERS:
  524. '           None.
  525. '***********************************************************************
  526.     Dim i As Long
  527.         
  528.     On Error Resume Next
  529.     'Loop through and delete all pixel shaders.
  530.     For i = 0 To UBound(hPixelShader)
  531.         If hPixelShader(i) Then
  532.             Call dev.DeletePixelShader(hPixelShader(i))
  533.             hPixelShader(i) = 0
  534.         End If
  535.     Next
  536.     'Destroy the vertex buffer if it exists.
  537.     If Not d3dvb Is Nothing Then Set d3dvb = Nothing
  538. End Sub
  539.